Analiza teksta

Analiza teksta dobiva na popularnosti zbog sve veće dostupnosti podataka i razvoja user friendly podrške za provedbu takve analize. Konceptualni pregled analize teksta ya sociologe je dostupan i u nedavno objavljenoj knjizi, koja se preporuča tek nakon savladavanja osnovnih tehničkih vještina i alata za obradu teksta. Provedba analize tekstualnih podataka je moguća na mnogo načina, a najšire korišten pristup je bag-of-words u kojem je frekvencija riječi polazište za analizu dok se (npr.) pozicija riječi u rečenici ili paragrafu zanemaruje. Bag of words pristup je ujedno i najjednostavniji (konceptualno i računarski) pa će biti korišten u ovom predavanju.

Postupak analize teksta započinje pripremom teksta (podataka), koja je često dosta zahtjevna i uključuje: uvoz teksta, operacije sa riječima, uređivanje i tokenizaciju, izradu matrice pojmova, filtiranje i ponderiranje podataka. Pri tome valja imati na umu da vrsta analize i korištena metoda određuju način na koji je potrebno pripremiti podatke za daljnu analizu te da svaka metoda ima svoje specifičnosti. Nakon pripreme podataka se vrši analiza teksta (podataka) metodama nadziranog strojnog učenja, ne-nadziranog strojnog učenja, statistike na tekstualnim podatcima, analize riječnika, analize sentimenta. Napredne metode analize podataka uključuju NLP, analizu pozicije riječi i sintakse…Sažeti prikaz workflow-a za analizu teksta izgleda ovako:

Procedura za analizu teksta.

Procedura za analizu teksta.

Software i korisni resursi

U ovom predavanju ćemo koristiti tidytext pristup (i istoimeni paket) za analizu tekstualnih podatka, detaljno opisan u knjizi Text Mining with R. Ovaj paket služi kako bismo tekstualne podatke “uveli” u tidyverse ovir pomoću kojeg je moguće nestrukturirani tekst analizirati sa otprije poznatim alatima iz dplyr i ggplot paketa. Učitajmo potrebne pakete:

library(tidyverse)
library(tidytext)
library(data.table)
library(lubridate)
library(grid)
library(wordcloud)
library(reshape2)
library(igraph)
library(ggraph)
library(widyr)
library(topicmodels)
library(ggthemes)
library(DT)
library(kableExtra)
library(ggplot2)
library(ggthemes)
library(scales)
library(tidyverse)
library(httr)
library(lubridate)
library(dplyr)
library(data.table)
library(tidytext)
library(plotly)
library(readxl)

Prije opisa podataka koje ćemo koristiti valja naglasiti da tidytext pristup nije jedini način za rad s podatcima u R. Ovdje ga koristimo jer je kompatibilan sa pristupima koje smo do sada koristili u okviru ovog kolegija. Drugi paketi (pristupi) za rad sa tekstom u R su:

  • quanteda je sveobuhvatan i funkcijama bogat paket, neophodan u za složeniju analizu teksta. Izvrstan tutorial je dostupan na linku.

  • text2vec je izrazito koristan paket za ML algoritme sa tekstualnim podatcima. Posebno je pogodan za izradu dtm i tcm matrica. Paket je motiviran python-ovom Gensim knjižnicom, a tutorial je dostupan na linku.

  • stringr paket je neophodan za manipulaciju string podataka u R i kao dio tidyverse svijeta će biti izrazito koristan u čišćenju i pripremi podataka. Vrlo je praktičan za rad sa regex-om i ima nekoliko izvrsnih funkcija za pattern matching. Službeni R Tutorial je dostupan na linku.

  • spacyr je wrapper paket za spaCy knjižnicu iz python-a i omogućava provedbu naprednijih NLP modela (deep learning, speech tagging, tkoenization, parsing) u R. Također je kompatibilan sa quanteda i tidytext paketima. Tutorial je dostupan na linku.

  • za one koji žele znati više mogu biti korisni i sljedeći resursi: vodič za tekstualnu analizu u R i kolegij za obradu prirodnog teksta u najstajnju koji sadrži i mnoštvo referenci.

Podatci

Svaka analiza (teksta) počinje od podataka. Pribava tekstualnih podataka o specifičnim temama najčešće nije jednostavna. Najčešći je način preuzimanja podataka neki od dostupnih API servisa za novinske članke ili tekstualnih repozitorija ili servisi poput Twitter-a. No to često nije dovoljno ukolilko želimo analizirati specifičnu temu ili temu na specifičnom jeziku (npr. hrvatskom). Ovdje još valja napomeniti da je preuzimanje kvalitetnih tekstualnih podataka često moguće isključivo uz nadoplatu kao što je to slučaj člancima na hrvatskom jeziku kroz webhose.io servis, presscliping, presscut i mediatoolkit

U ovom ćemo predavanju analizirati tržište aparata za kavu u Hrvatskoj na osnovi osnovi svih tekstova objavljenih u svim domaćim medijima u perodu od 2021-01-09) do 2022-11-01. Članci su preuzeti strojno sa mediatoolkit servisa i na način da sadrže riječ: LatteGo, De`Longhi, Krups i Nesspreso. Na taj je način prikupljeno 290 objava koje sadrže ukupno 8.980 riječi. Analiza teksta koju ćemo provesti uključuje: čišćenje, uređivanje i prilagodbu podataka, dekriptivnu statistiku na tekstualnim podatcima, analizu sentimenta, analizu frekvencija i tematsku analizu.

Uvoz podataka

Podatci za analizu su prikupljeni na prethodno opisan način i dostupni u GitHub repozitoriju kolegija (Dta folder;korona.csv file). Podataci uključuju i članke sa nekih drugih portala, ali u kraćem vremenskom rasponu pa su izostavljeni iz analize. Učitajmo podatke:

kava <- read_excel("../Dta/kava.xlsx") #, encoding="UTF-8"
glimpse(kava)
## Rows: 289
## Columns: 45
## $ DATE                  <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-~
## $ TIME                  <chr> "09:18:45", "18:32:43", "08:00:26", "18:00:00", ~
## $ TITLE                 <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ FROM                  <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ AUTHOR                <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ URL                   <chr> "https://www.instagram.com/p/CYiubD4owlX/", "htt~
## $ URL_PHOTO             <chr> "https://mediatoolkit.com/img/50x50,sc,s-3IcNbqA~
## $ SOURCE_TYPE           <chr> "instagram", "twitter", "instagram", "twitter", ~
## $ GROUP_NAME            <chr> "Philips", "Philips", "Philips", "Philips", "Phi~
## $ KEYWORD_NAME          <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso"~
## $ FOUND_KEYWORDS        <chr> "nespresso", "Nespresso", "LatteGo, lattego", "n~
## $ LANGUAGES             <chr> "hr, et, no", "hr", "hr, bs", "hr, sk", "hr", "h~
## $ LOCATIONS             <chr> "EE, NO, HR", "HR", "HR, BA", "SK, HR", "HR", "H~
## $ TAGS                  <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ MANUAL_SENTIMENT      <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ AUTO_SENTIMENT        <chr> "neutral", "neutral", "positive", "neutral", "ne~
## $ MENTION_SNIPPET       <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ REACH                 <dbl> 50, 0, 30, 22, NA, NA, NA, NA, 10, 77, 0, 50, 46~
## $ VIRALITY              <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.0000000, 0~
## $ FOLLOWERS_COUNT       <dbl> 0, 9, 0, 449, NA, NA, NA, NA, 0, NA, NA, 259, NA~
## $ LIKE_COUNT            <dbl> 5, NA, 3, NA, NA, NA, NA, NA, 1, 0, 0, 3, 91, 0,~
## $ COMMENT_COUNT         <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, 0, 0, 2, 16, 0,~
## $ SHARE_COUNT           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0, 0, NA, 6,~
## $ TWEET_COUNT           <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LOVE_COUNT            <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ WOW_COUNT             <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ HAHA_COUNT            <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ SAD_COUNT             <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ ANGRY_COUNT           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ TOTAL_REACTIONS_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ FAVORITE_COUNT        <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ RETWEET_COUNT         <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ VIEW_COUNT            <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 0, NA, ~
## $ DISLIKE_COUNT         <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COMMENTS_COUNT        <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LIKES                 <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ DISLIKES              <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COUNT                 <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REPOST_COUNT          <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_TYPE           <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_SCORE          <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ INFLUENCE_SCORE       <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 3, 1, 1, 3, ~
## $ TWEET_TYPE            <chr> NA, "ORIGINAL", NA, "ORIGINAL", NA, NA, NA, NA, ~
## $ TWEET_SOURCE_NAME     <chr> NA, "Twitter Web App", NA, "Twitter for Android"~
## $ TWEET_SOURCE_URL      <chr> NA, "https://mobile.twitter.com", NA, "http://tw~

Nakon što smo učitali podatke u radni prostor R, potrebno je učitati i druge podatke koji su nam potrebni za ovu analizu. Osim članaka, potrebni su nam leksikoni i stop riječi. Leksikone ćemo preuzeti iz FER-ovog repozitorija, a “stop riječi” ćemo napraviti sami.

## M-Files ----
# function to parse JSON from http conenctiion
parseJSON <- function(x) {
  xCon <- content(x, as = "text", type = "aplication/json", encoding = "UTF-8")
  xCon <- jsonlite::fromJSON(xCon, flatten = TRUE)
  xCon
}
# GET REST API function M-Files
mfiles_get <- function(token, resource){
  req <- GET(url = paste0('http://server.contentio.biz/REST', resource),
             add_headers('X-Authentication' = token, 'content-type' = "application/json"))
  result <- parseJSON(req)
  return(result)
}
# GET token M-Files
req <- POST(url = 'http://server.contentio.biz/REST/server/authenticationtokens.aspx', 
            config = add_headers('content-type' = "application/json"),
            body = list(Username = "msagovac", Password = "Wc8O10TaHz40",
                        VaultGuid = "{7145BCEB-8FE2-4278-AD3B-7AE70374FF8A}",
                        ComputerName  = "CT-VM-01"),
            encode = "json", verbose())
token <- parseJSON(req)[[1]]
# M-FILES DOWNLOAD FILES
mfiles_downlaod <- function(objType, objId, fileId) {
  req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/', 
                          objId, '/latest/files/',fileId , '/content'),
             add_headers('X-Authentication' = token))
  reqCon <- content(req, as = "text", encoding = "UTF-8")
  if (is.na(reqCon)) {
    reqCon <- content(req, as = "raw", encoding = "UTF-8")
    reqCon <- rawToChar(reqCon, multiple = FALSE)
    reqCon <- iconv(reqCon, "", "UTF-8")
  }
  reqCon
}
mfiles_downlaod_txt <- function(objType, objId, fileId, ext = ".csv") {
  req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/', 
                          objId, '/latest/files/',fileId , '/content'),
             add_headers('X-Authentication' = token))
  reqCon <- httr::content(req)
  tempFileSave <- paste0(tempfile(), ext)
  writeBin(reqCon, tempFileSave)
  return(tempFileSave)
}
# GET classess, props and others
prop <- mfiles_get(token, "/structure/properties")
prop <- prop %>% 
  select(DataType, ID, Name, ObjectType) %>% 
  dplyr::arrange(Name)
objs <- mfiles_get(token, "/structure/objecttypes")
mfilesClass <- mfiles_get(token, "/structure/classes")
CroSentilex_n <- read.delim(mfiles_downlaod_txt("0", 136679, 136711, ext = ".txt"),
                            header = FALSE,
                            sep = " ",
                            stringsAsFactors = FALSE) %>% 
  rename(word = "V1", sentiment = "V2" ) %>%
  mutate(brija = "NEG")
CroSentilex_p <- read.delim(mfiles_downlaod_txt("0", 136681, 136713, ext = ".txt"),
                            header = FALSE,
                            sep = " ",
                            stringsAsFactors = FALSE) %>% 
  rename(word = "V1", sentiment = "V2" ) %>%
  mutate(brija = "POZ")
Crosentilex_sve <- rbind(setDT(CroSentilex_n), setDT(CroSentilex_p))
#head(Crosentilex_sve)
CroSentilex_Gold  <- read.delim2(mfiles_downlaod_txt("0", 136680, 136712, ext = ".txt"),
                                 header = FALSE,
                                 sep = " ",
                                 stringsAsFactors = FALSE) %>%
  rename(word = "V1", sentiment = "V2" ) 
CroSentilex_Gold[1,1] <- "dati"
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "-", "1")
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "\\+", "2")
CroSentilex_Gold$sentiment <- as.numeric(unlist(CroSentilex_Gold$sentiment))
#head(CroSentilex_Gold)
# leksikoni
stopwords_cro <- get_stopwords(language = "hr", source = "stopwords-iso")
my_stop_words <- tibble(
  word = c(
    "jedan",
    "e","prvi", "dva","dvije","drugi",
    "tri","tre?i","pet","kod",
    "ove","ova",  "ovo","bez",
    "evo","oko",  "om", "ek",
    "mil","tko","?est", "sedam",
    "osam",   "?im", "zbog",
    "prema", "dok","zato", "koji", 
    "im", "?ak","me?u", "tek",
    "koliko", "tko","kod","poput", 
    "ba?", "dakle", "osim", "svih", 
    "svoju", "odnosno", "gdje",
    "kojoj", "ovi", "toga","ima","treba","sad","to","kad", "?e","ovaj","?ta","onda","ce","ko"
  ),
  lexicon = "lux"
)
stop_corpus <- my_stop_words %>%
  bind_rows(stopwords_cro)
kava %>%
   mutate(kword = case_when(grepl("latteg", MENTION_SNIPPET, ignore.case = TRUE) ~ "LatteGo",
                            grepl("longhi", MENTION_SNIPPET, ignore.case = TRUE) ~ "DeLonghi",
                            grepl("krups", MENTION_SNIPPET, ignore.case = TRUE) ~ "Krups",
                            grepl("Nespresso", MENTION_SNIPPET, ignore.case = TRUE) ~ "Nespresso")) -> kava

kava %>%  
#  filter(SOURCE_TYPE == "web" & kword == "bosch") %>%
  unnest_tokens(word, MENTION_SNIPPET) %>%
  anti_join(stop_corpus, by = "word") %>%
  mutate(word = gsub("\\d+", NA, word)) %>%
  mutate(word = gsub("^[a-zA-Z]$", NA, word)) %>%
  filter(!is.na(word)) -> rijeci_clean

Prilagodba podataka

U sljedećem koraku ćemo prilagoditi podatke u tidy format koji je prikladan za analizu. Pri tome pretvaramo podatke u dataframe, izabiremo varijable za analizu, specificiramo vremenski pečat članka kao datumsku varijablu, pripisujemo id svakom članku, izabiremo vremenski raspon analize i portale:

# prilagodi podatke
newskava <- kava %>% 
  as.data.frame() %>%
  select(TITLE,MENTION_SNIPPET, DATE, SOURCE_TYPE, AUTHOR, FROM, kword) %>%  
  mutate(datum = as.Date(DATE,"%Y-%m-%d")) %>%
  mutate(clanak = 1:n()) 

# brzi pregled strukture podataka
glimpse(newskava)
## Rows: 289
## Columns: 9
## $ TITLE           <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ MENTION_SNIPPET <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ DATE            <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-01-06"~
## $ SOURCE_TYPE     <chr> "instagram", "twitter", "instagram", "twitter", "forum~
## $ AUTHOR          <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ FROM            <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ kword           <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso", "Nes~
## $ datum           <date> 2022-01-10, 2022-01-08, 2022-01-07, 2022-01-06, 2022-~
## $ clanak          <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,~
# izgled podataka
# newskava %>%
#   sample_n(.,10)

datatable(newskava, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

U sljedećem koraku provodimo tokenizaciju, odnosno pretvaranje teksta na jedinice analize. U ovom slučaju su to riječi:

# tokenizacija

newskava %>% 
  unnest_tokens(word, MENTION_SNIPPET) -> newskava_token 

#newsCOVID_token$word <- stri_encode(newsCOVID_token$word, "", "UTF-8") # prilagodi encoding

datatable(newskava_token, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

Potom valja očistiti riječi od brojeva i nepotrebnih riječi. Na tako uređenim podatcima ćemo napraviti deskriptivno- statistički pregled teksta.

## Ukloni "stop words", brojeve, veznike i pojedinačna slova

newskava_token %>% 
  anti_join(stop_corpus, by = "word") %>%
  mutate(word = gsub("\\d+", NA, word)) %>%
  mutate(word = gsub("^[a-zA-Z]$", NA, word)) %>% 
  drop_na(.)-> newskava_tokenTidy

datatable(newskava_tokenTidy, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

Na tako uređenim podatcima ćemo napraviti deskriptivno-statistički pregled teksta:

# DESKRIPTIVNI PREGLED PODATAKA

## Vremenski raspon analize
range(newskava_token$DATE)
## [1] "2021-09-01" "2022-01-10"
## Najčešće riječi
newskava_tokenTidy %>%
  count(word, sort = T) %>%
  head(25)
##          word   n
## 1    hrvatska 147
## 2   nespresso  92
## 3   de’longhi  60
## 4     lattego  45
## 5         dom  35
## 6     bauhaus  33
## 7      coffee  31
## 8        kavu  31
## 9     philips  31
## 10    samsung  31
## 11         my  25
## 12       kave  21
## 13     istria  20
## 14      https  19
## 15    mikulec  19
## 16     aparat  18
## 17    citroën  18
## 18       jysk  18
## 19       kler  18
## 20 namještaja  18
## 21 pogledajte  18
## 22     qualis  18
## 23      salon  18
## 24     akcija  17
## 25      krups  17
## Vizualizacija najčešćih riječi
newskava_tokenTidy %>%
  count(word, sort = T) %>%
  filter(n > 10) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  theme_economist()

## Vizualizacija najčešćih riječi kroz vrijeme
newskava_tokenTidy %>%
   mutate(Datum = floor_date(datum, "day")) %>%
   group_by(Datum) %>%
   count(word) %>% 
   mutate(gn = sum(n)) %>%
   filter(word %in%  c("nespresso", "de’longhi", "lattego", "krups")) %>%
   ggplot(., aes(Datum,  n / gn)) + 
   geom_point() +
   ggtitle("Učestalost korištenja kroz vrijeme") +
   ylab("% ukupnih riječi") +
   geom_smooth() +
   facet_wrap(~ word, scales = "free_y") +
   scale_y_continuous(labels = scales::percent_format())+
   theme_economist()

Također je moguće napraviti i deskriptivno-statistički pregled domena:

# DESKRIPTIVNI PREGLED DOMENA

## Broj domena
newskava_tokenTidy %>% 
  summarise(Domena = n_distinct(SOURCE_TYPE))
##   Domena
## 1      6
## Broj članaka po domeni

kava %>% 
 # drop_na(.) %>%
  group_by(SOURCE_TYPE) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>% 
  head(20)
## # A tibble: 7 x 2
##   SOURCE_TYPE     n
##   <chr>       <int>
## 1 web           110
## 2 facebook       73
## 3 instagram      51
## 4 forum          44
## 5 youtube         5
## 6 twitter         4
## 7 reddit          2
## Broj članaka po brandu

kava %>% 
 # drop_na(.) %>%
  group_by(kword) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>% 
  head(20)
## # A tibble: 4 x 2
##   kword         n
##   <chr>     <int>
## 1 Nespresso   135
## 2 DeLonghi     84
## 3 Krups        35
## 4 LatteGo      35
## Broj članaka po domeni 

newskava %>% 
   mutate(Datum = floor_date(datum, "week")) %>%
   group_by(Datum, SOURCE_TYPE) %>%
   summarise(n = n()) %>%
   ungroup() %>%
   ggplot(., aes(Datum,  n)) + 
   geom_line() +
   ggtitle("Broj članaka o kafe aparatima kroz vrijeme") +
   ylab("Broj članaka") +
   geom_smooth() +
   facet_wrap(~ SOURCE_TYPE, scales = "free_y") +
   theme_economist()

## Broj članaka po brandu 

newskava %>% 
   mutate(Datum = floor_date(datum, "week")) %>%
   group_by(Datum, kword) %>%
   summarise(n = n()) %>%
   ungroup() %>%
   ggplot(., aes(Datum,  n)) + 
   geom_line() +
   ggtitle("Članci na najvažnijim portalima") +
   ylab("Broj objavljenih COVID članaka") +
   geom_smooth() +
   facet_wrap(~ kword, scales = "free_y") +
   theme_economist()

Analiza sentimenta

Nakon uređivanja podataka i osnovnog pregleda najvažnijih riječi, dinamike kretanja članaka kroz vrijeme i pregleda deskriptivne statistike domena ćemo provesti analizu sentimenta. Za analizu sentimenta je potrebno preuzeti leksikone sentimenta koji su za hrvatski jezik dostupni kroz FER-ov Croatian Sentiment Lexicon. Analiza sentimenta i uključuje sentiment kroz vrijeme, doprinos riječi sentimentu, ‘wordCloud’ i analizu negativnosti portala.

Pogledajmo prvo kako izgledaju leksikoni (koje smo učitali na početku):

## Pregled leksikona
CroSentilex_n %>% sample_n(10)
##          word sentiment brija
##  1:       jug  0.267830   NEG
##  2:  granićev  0.369870   NEG
##  3:  delicija  0.390510   NEG
##  4: popratiti  0.537450   NEG
##  5:  eskapada  0.270050   NEG
##  6:     besek  0.307330   NEG
##  7:    azbest  0.286470   NEG
##  8:   čehinja  0.413140   NEG
##  9:    ostoić  0.064668   NEG
## 10:  odjeljak  0.418990   NEG
CroSentilex_p %>% sample_n(10)
##              word sentiment brija
##  1:       joaquin  0.415890   POZ
##  2:     aljkavost  0.095874   POZ
##  3:     provladin  0.168150   POZ
##  4:     uvjetovan  0.624090   POZ
##  5:       narušen  0.570920   POZ
##  6: prirodoslovac  0.153720   POZ
##  7:     platforma  0.518390   POZ
##  8:         gould  0.586390   POZ
##  9:        mandić  0.575160   POZ
## 10:        vikend  0.277400   POZ
Crosentilex_sve %>% sample_n(10)
##           word sentiment brija
##  1:  mahmuljin  0.037049   POZ
##  2:      vogel  0.206810   POZ
##  3:    odrezak  0.352550   NEG
##  4:       hill  0.517380   NEG
##  5:      karas  0.347810   POZ
##  6: prikupljen  0.450830   POZ
##  7:    mjuzikl  0.392780   NEG
##  8:      đodan  0.052148   POZ
##  9:  kopljanik  0.376760   POZ
## 10:   kuponski  0.288300   NEG
CroSentilex_Gold %>% sample_n(10)
##          word sentiment
## 1     vladati         0
## 2        piće         0
## 3      pomoći         2
## 4       majka         2
## 5  operativan         0
## 6  podružnica         0
## 7   besplatan         2
## 8       znati         2
## 9     voljeti         2
## 10  slavonski         0

Provjerimo kretanje sentimenta u vremenu:

## Kretanje sentimenta kroz vrijeme
vizualiziraj_sentiment <- function(dataset, frq = "week") {

dataset %>%
  inner_join( Crosentilex_sve, by = "word") %>%
  filter(!is.na(word)) %>%
  select(word, brija, datum, sentiment) %>% 
  unique() %>%
  spread(. , brija, sentiment) %>%
  mutate(sentiment = POZ - NEG) %>%
  select(word, datum, sentiment) %>% 
  group_by(word) %>% 
  mutate(count = n()) %>%
  arrange(desc(count)) %>%
  mutate( score = sentiment*count) %>%
  ungroup() %>%
  group_by(datum) %>%
  arrange(desc(datum)) -> sm

 
sm %>%
  select(datum, score) %>%
  group_by(Datum = floor_date(datum, frq)) %>%
  summarise(Dnevni_sent = sum(score, na.rm = TRUE)) %>%
  ggplot(., aes(Datum, Dnevni_sent)) +
  geom_bar(stat = "identity") + 
  ggtitle(paste0("Sentiment kroz vrijeme;frekvencija podataka:", frq)) +
  ylab("SentimentScore") +
  theme_economist()-> gg_sentiment_kroz_vrijeme_qv


gg_sentiment_kroz_vrijeme_qv

}

vizualiziraj_sentiment(newskava_tokenTidy,"week")

Korisno je i promotriti koje riječi najviše doprinose sentimentu (pozitivnom, negativnom i neutralnom):

## Doprinos sentimentu
doprinos_sentimentu <- function(dataset, no = n) {
dataset %>%
  inner_join(CroSentilex_Gold, by = "word") %>% 
  count(word, sentiment,sort = TRUE) %>% 
  group_by(sentiment) %>%
  top_n(no) %>%
  ungroup() %>%
  mutate(sentiment = case_when(sentiment == 0 ~ "NEUTRALNO",
                                 sentiment == 1 ~ "NEGATIVNO",
                                 sentiment == 2 ~ "POZITIVNO")) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  ggtitle( "Doprinos sentimentu") +
  labs( x = "Riječ", y = "Broj riječi") +
  facet_wrap(~ sentiment, scales = "free_y") +
  coord_flip() +
  theme_economist() -> gg_doprinos_sentimentu
  
 gg_doprinos_sentimentu
 
}


doprinos_sentimentu(newskava_tokenTidy,15)

Korisno je pogledati i WordCloud sentiment. Pogledajmo “obični” WordCloud prije toga:

## WordCloud(vulgaris)
newskava_tokenTidy %>%
  anti_join(CroSentilex_Gold,by="word") %>% 
  count(word) %>% 
  arrange(desc(n)) %>%
  top_n(100) %>%
  with(wordcloud(word, n, max.words = 80)) 

Ovako izgleda WordCloud koji sadržava i prikaz sentimenta:

## ComparisonCloud
newskava_tokenTidy %>%
  inner_join(CroSentilex_Gold,by="word") %>% 
  count(word, sentiment) %>% 
  top_n(200) %>%
  mutate(sentiment = case_when(sentiment == 0 ~ "+/-",
                                 sentiment == 1 ~ "-",
                                 sentiment == 2 ~ "+")) %>%
  acast(word ~ sentiment, value.var = "n", fill = 0) %>%
  comparison.cloud(colors = c("firebrick3", "deepskyblue3","darkslategray"),
                   max.words = 120)

Analiza sentimenta se može iskoristiti za pregled negativnosti pojedinih brandova:

…također i pozitivnosti brandova:

## Najpozitivniji portali

CroSentilex_Gold_poz <- CroSentilex_Gold %>% filter(sentiment == 2)

newskava_tokenTidy %>% 
  semi_join(CroSentilex_Gold_poz, by= "word") %>%
  group_by(kword) %>% 
  summarise(pozWords = n()) %>%
  left_join(wCount, by = "kword") %>%
  mutate(pozitivnostIndex = (pozWords/word)*100) %>%
  arrange(desc(pozitivnostIndex))  
## # A tibble: 4 x 4
##   kword     pozWords  word pozitivnostIndex
##   <chr>        <int> <int>            <dbl>
## 1 DeLonghi        41  1408             2.91
## 2 LatteGo         10   547             1.83
## 3 Nespresso       20  1106             1.81
## 4 Krups            4   250             1.6

Analiza važnosti pojmova

Nakon analize sentimenta je korisno analizirati i najbitnije riječi. To se radi pomoću IDF (inverse document frequency) metode. IDF metoda omogućuje identifikaciju važnih (ne nužno čestih) riječi u korpusu i može poslužiti za analizu najvažnijih pojmova po brandovima.

## Udio riječi po domenama

domenaWords <- newskava %>%
  unnest_tokens(word,MENTION_SNIPPET) %>% 
  count(kword, word, sort = T)
  
ukupnoWords <- domenaWords %>%
  group_by(kword) %>%
  summarise(totWords = sum(n))

domenaWords <- left_join(domenaWords, ukupnoWords)


# domenaWords %>% head(15)

# domenaWords %>% 
# ggplot(., aes(n/totWords, fill = domena)) +
#   geom_histogram(show.legend = FALSE) +
#   xlim(NA, 0.0009) +
#   facet_wrap(~domena, ncol = 2, scales = "free_y")

## Najbitnije riječi po domenma

idf <- domenaWords %>%
  bind_tf_idf(word, kword, n)

idf %>% head(10)
##        kword      word   n totWords         tf       idf     tf_idf
## 1  Nespresso nespresso 181     4143 0.04368815 0.2876821 0.01256830
## 2   DeLonghi  hrvatska 146     2607 0.05600307 0.6931472 0.03881837
## 3  Nespresso        za 144     4143 0.03475742 0.0000000 0.00000000
## 4  Nespresso         i 136     4143 0.03282645 0.0000000 0.00000000
## 5  Nespresso         u 115     4143 0.02775766 0.0000000 0.00000000
## 6  Nespresso        je 108     4143 0.02606807 0.0000000 0.00000000
## 7   DeLonghi         u  82     2607 0.03145378 0.0000000 0.00000000
## 8   DeLonghi de’longhi  72     2607 0.02761795 1.3862944 0.03828661
## 9    LatteGo   lattego  58     1088 0.05330882 1.3862944 0.07390172
## 10     Krups     krups  50     1142 0.04378284 0.6931472 0.03034795
# idf %>% 
#   select(-totWords) %>%
#   arrange(desc(tf_idf))

idf %>%
  arrange(desc(tf_idf)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>% 
  mutate(domena = factor(kword)) %>%
  group_by(domena) %>% 
  top_n(10,tf_idf) %>% 
  ungroup() %>%
  ggplot(aes(word, tf_idf, fill = kword)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~kword, scales = "free") +
  coord_flip() +
  theme_economist()

nGrami

Do sada smo analizirali tekst tako da je tekst tokeniziran na jednu riječ. To može prikriti bitne nalaze do kojih je moguće doći kada se tekst tokenizira na fraze (dvije ili N riječi). U sljedećemo koraku ćemo tokenizirati tekst na bigrame (dvije riječi) kako bismo proveli frazeološku analizu. Korištenje bigrama omogućava korištenje dodatnih metoda pa ćemo provesti i analizu korelacije među riječima.

newskava_bigram <- newskava %>%
  unnest_tokens(bigram, MENTION_SNIPPET, token = "ngrams", n = 2)

newskava_bigram %>% head(10)
##                                                                                                                                                                                           TITLE
## 1  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 2  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 3  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 4  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 5  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 6  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 7  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 8  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 9  Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 10 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
##          DATE SOURCE_TYPE         AUTHOR           FROM     kword      datum
## 1  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 2  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 3  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 4  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 5  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 6  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 7  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 8  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 9  2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 10 2022-01-10   instagram anonymous_user anonymous_user Nespresso 2022-01-10
##    clanak            bigram
## 1       1       hello hello
## 2       1      hello monday
## 3       1    monday january
## 4       1    january winter
## 5       1        winter day
## 6       1          day work
## 7       1      work longday
## 8       1 longday nespresso
## 9       1    nespresso cafe
## 10      1       cafe coffee
newskava_bigram %>%
  count(bigram, sort = T) %>%
  head(25)
##                      bigram  n
## 1                   za kavu 64
## 2        de’longhi hrvatska 44
## 3                 aparat za 36
## 4          bauhaus hrvatska 33
## 5              nespresso je 24
## 6                      je u 22
## 7          istria de’longhi 20
## 8                 my istria 20
## 9             jysk hrvatska 18
## 10            kler hrvatska 18
## 11          namještaja kler 18
## 12             qualis salon 18
## 13         salon namještaja 18
## 14                    dom s 16
## 15       hrvatska family.hr 16
## 16         mirjanom mikulec 16
## 17               s mirjanom 16
## 18              tražimo dom 16
## 19                   dom po 15
## 20                  moj dom 15
## 21                   za sve 15
## 22      family.hr de’longhi 14
## 23          hrvatska svijet 14
## 24             lesnina xxxl 14
## 25 philipshomeliving coffee 14
newskava_bigram_sep <- newskava_bigram %>%
  separate(bigram, c("word1","word2"), sep = " ")

newskava_bigram_tidy <- newskava_bigram_sep %>%
  filter(!word1 %in% stop_corpus$word) %>%
  filter(!word2 %in% stop_corpus$word) %>%
  mutate(word1 = gsub("\\d+", NA, word1)) %>%
  mutate(word2 = gsub("\\d+", NA, word2)) %>%
  mutate(word1 = gsub("^[a-zA-Z]$", NA, word1)) %>%
  mutate(word2 = gsub("^[a-zA-Z]$", NA, word2)) %>% 
  drop_na(.)


newskava_bigram_tidy_bigram_counts <- newskava_bigram_tidy %>% 
  count(word1, word2, sort = TRUE)


#newsCOVID_bigram_tidy_bigram_counts

bigrams_united <- newskava_bigram_tidy %>%
  drop_na(.) %>%
  unite(bigram, word1, word2, sep = " ")

#bigrams_united

bigrams_united %>% 
  count(clanak,bigram,sort = T) -> topicBigram

# Najvažniji bigrami po domenama

 bigram_tf_idf <- bigrams_united %>%
  count(kword, bigram) %>%
  bind_tf_idf(bigram, kword, n) %>%
  arrange(desc(tf_idf))

bigram_tf_idf %>%
  arrange(desc(tf_idf)) %>%
  mutate(bigram = factor(bigram, levels = rev(unique(bigram)))) %>% 
  group_by(kword) %>% 
  top_n(7) %>% 
  ungroup() %>%
  ggplot(aes(bigram, tf_idf, fill = kword)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~kword, ncol = 2, scales = "free") +
  coord_flip() + 
  theme_economist()

# Analiza bigramskih fraza

newskava_bigram_tidy %>%
  filter(word1 == "kava") %>%
  count(word1,word2,sort=T)

# Vizualiziraj bigrame

bigram_graph <- newskava_bigram_tidy_bigram_counts %>%
  filter(n >50) %>%
   graph_from_data_frame()

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))

ggraph(bigram_graph, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

Provjerimo koje su riječi najviše korelirane sa izabranim ključnim riječima:

# Korelacije riječi ( R crash na T=30)

#newsCOVID_tokenTidy %>% 
#  filter(published == "2020-04-22") %>%
#  pairwise_count(word, domena, sort = T) %>%
#  filter_all(any_vars(!is.na(.))) -> pairsWords

newskava_tokenTidy %>% 
#  filter(datum > "2020-02-20") %>%
  group_by(word) %>%
  filter(n() > 20) %>%
  filter(!is.na(word)) %>%
  pairwise_cor(word,datum, sort = T) -> corsWords

#corsWords %>%
#  filter(item1 == "oporavak")

corsWords %>%
  filter(item1 %in% c("de’longhi", "krups", "lattego", "nespresso", "dom")) %>%
  group_by(item1) %>%
  top_n(10) %>%
  ungroup() %>%
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ item1, scales = "free") +
  coord_flip() + 
  theme_economist()

Tematska analiza

Na kraju provodimo tematsku analizu kao najsloženiji dio do sada provedene analize. Pri tome koristimo LDA (Latent Dirichlet allocation) algoritam kako bismo pronašli najvažnije riječi u algoritamski identificiranim temama. Ovdje je važno primijetiti da prije provedbe LDA modela valja tokenizirane riječi pretvoriti u matricu pojmova (document term matrix) koju ćemo kasnije koristiti kao input za LDA algoritam.

newskava_tokenTidy %>%
  count(clanak, word, sort = TRUE) %>%
  cast_dtm(clanak, word,n) -> dtm

newskava_LDA <- LDA(dtm, k = 4,  control = list(seed = 1234))

newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy

newskava_terms <- newskava_LDA_tidy %>%
  drop_na(.) %>%
  group_by(topic) %>%
  top_n(15, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

#newsCOVID_terms

newskava_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered() + 
  theme_economist()

Tematsku analizu je moguće i napraviti na bigramski tokeniziranom tekstu. Tada je često moguće doći do preciznijih i kontekstualno relevantnijih uvida:

# Bigrami 

topicBigram %>%
  cast_dtm(clanak, bigram,n) -> dtmB

newskava_LDA <- LDA(dtmB, k = 4,  control = list(seed = 1234))

newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy

newskava_terms <- newskava_LDA_tidy %>%
  drop_na(.) %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

#newsCOVID_terms


newskava_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered() + 
  theme_economist()

Zaključak

U ovom smo predavanju dali uvodni pregled mogućnosti analize teksta u okviru tidytext paketa. Riječ je o skupu alata koji omogućavaju “prilagodbu” teksta u tidy format i daljnu analizu s tidyverse alatima koje smo do sada već dobro upoznali. tidytext nije jedini dostupan okvir za analizu teksta u R, već postoji i niz drugih paketa (vidi na početku) koji omogućavaju korištenje naprednijih (algoritamkskih tehnika.

U predavanju su korišteni tekstovi objavljeni na tri domaća portala o temi COVID-19 u razdoblju od prvog zabilježenog slučaja u RH do danas. Analiza je pokazala mogućnosti tekstualne analize te osnovnih tehnika i alata na aktualnom primjeru.

Analiza teksta je trenutno (brzo) rastuće istraživačko područje sa sve većim brojem primjena, novih metodoloških pristupa i perspektiva. Dostupno je mnoštvo kvalitetnih i korisnih resursa pa se zainteresiranim studentima preporuča uključivanje u ovu (vrlo perspektivnu) istraživačku paradigmu.